home *** CD-ROM | disk | FTP | other *** search
- unit UserInfo;
-
- interface
-
- uses
- Classes, SysUtils, Wincrt, IniFiles, WinTypes, WinProcs, dbtables, Controls
- , PasUtils
- , Xtension
- , Debug;
-
- Type
-
- TComponentExtended = class(TComponent)
- cx: TComponentExtensions;
- public
- Constructor Create(aOwner:TComponent); Override;
- Destructor Destroy; Override;
- end;
-
- TUserInfoOptionTypes = (uifUpdateOnLoad,uifUpdateInDesign,uifUpdateOnGet);
- TUserInfoOptions = set of TUserInfoOptionTypes;
- TUserInfoStateTypes = (uifUpdating,uifUpdated);
- TUserInfoState = set of TUserInfoStateTypes;
-
- TUserInfo = class(TComponentExtended)
- private
- fOptions: TUserInfoOptions;
- fState: TUserInfoState;
- protected
- function GetState:TUserInfoState;
- procedure SetState(Value:TUserInfoState);
- function GetUpdated: Boolean;
- procedure SetUpdated(Value:Boolean);
- function CanUpdate:Boolean;
- public
- Constructor Create(aOwner:TComponent); Override;
- procedure Loaded; Override;
- procedure Update;
- function UpdateOK:Boolean; Virtual;
- published
- property Options: TUserInfoOptions read fOptions write fOptions; {what we can do}
- property State: TUserInfoState read fState write SetState stored False; {what we did}
- property Updated: Boolean read GetUpdated write SetUpdated stored false; {if we did}
- end;
-
- TDialogShell = class(TComponentExtended)
- protected
- procedure SetTest(Value:Boolean); virtual;
- function GetTest:Boolean; virtual;
- public
- constructor Create(aOwner:Tcomponent); Override;
- procedure Execute; virtual;
- published
- property Test: Boolean read GetTest write SetTest stored False;
- end;
-
- implementation
-
- uses Dialogs;
-
- {-----------------------------------------------------------------------------------------}
- { }
- {-----------------------------------------------------------------------------------------}
- {-----------------------------------------------------------------------------------------}
- { TComponentExtended OBJECT CREATION }
- {-----------------------------------------------------------------------------------------}
-
- Constructor TComponentExtended.Create(aOwner:TComponent);
- begin
- inherited Create(aOwner);
- cx:=TComponentExtensions.Create(Self);
- if (decCreate in DebugFlags) then
- DebugLog(Owner,'Create '+ClassName+' ('+Owner.Name+':'+Owner.ClassName+')');
- end;
-
- Destructor TComponentExtended.Destroy;
- begin
- if (decDestroy in DebugFlags) then
- DebugLog(Owner,'Destroy '+ClassName);
- cx.Free;
- inherited Destroy;
- end;
-
- {-----------------------------------------------------------------------------------------}
- { TDialogShell BASE OBJECT OBJECT CREATION }
- {-----------------------------------------------------------------------------------------}
-
- Constructor TDialogShell.Create(aOwner:TComponent);
- begin
- inherited Create(aOwner);
- end;
-
- procedure TDialogShell.Execute;
- begin
- end;
-
- procedure TDialogShell.SetTest(Value:Boolean);
- begin
- Execute;
- end;
-
- function TDialogShell.GetTest:Boolean;
- begin
- Result:=True;
- end;
-
-
- {-----------------------------------------------------------------------------------------}
- { TUserInfo BASE OBJECT OBJECT CREATION }
- {-----------------------------------------------------------------------------------------}
-
- Constructor TUserInfo.Create(aOwner:TComponent);
- begin
- inherited Create(aOwner);
- Options:=[uifUpdateOnLoad,uifUpdateInDesign,uifUpdateOnGet];
- end;
-
- procedure TUserInfo.Loaded;
- begin
- if (decLoaded in DebugFlags) then
- DebugLog(Owner,'Loaded '+ClassName);
- inherited Loaded;
- if not (csDesigning in ComponentState) then
- if uifUpdateOnLoad in Options then
- Update {actually 'update on load'}
- else
- else
- if uifUpdateInDesign in Options then
- Update; {might be ok to update in design mode as well}
- end;
-
- procedure TUserInfo.SetState(Value:TUserInfoState);
- begin
- {basically read-only, showing if prop editor because this proc is ref'd}
- {made sensitive to -uifUpdated to allow cx.NilIfSet to unupdate a Userinfo Component}
- if Value=fState-[uifUpdated] then
- fState:=Value;
- end;
-
- function TUserInfo.GetState:TUserInfoState;
- {purpose is to call the update proc when we try to turn the property on.}
- begin
- if uifUpdateOnGet in Options then
- Update;
- Result:=fState;
- end;
-
- function TUserInfo.GetUpdated: Boolean;
- begin
- if uifUpdateOnGet in Options then
- Update;
- Result:=uifUpdated in State; {might trigger autoupdate on read. that why we have the proc!}
- end;
-
- procedure TUserInfo.SetUpdated(Value:Boolean);
- begin
- if not Value then
- State:= State - [uifUpdated]
- else
- if not (uifUpdated in State) and Value then
- Update;
- end;
-
- procedure TUserInfo.Update;
- begin
- if ([uifUpdating,uifUpdated]*fState)<>[] then {sets intersect,e.g. state is either updating or updated}
- exit;
- fState:=fState+[uifUpdating]; {MUST access field, changing this property does not change the field!}
- if CanUpdate then
- fState:=fState+[uifUpdated];
- fState:=fState-[uifUpdating];
- end;
-
- function TUserInfo.CanUpdate:Boolean;
- {purpose is to call the update proc when we try to turn the property on.}
- begin
-
- if (decUpdate in DebugFlags) then
- with cx do begin
- DebugLog(Owner,'+Update '+Self.ClassName);
- Result:=UpdateOK;
- DebugLog(Owner,'-Update '+Self.ClassName+':= '+BoolString[Result]);
- end
- else
- Result:=UpdateOK {finally we see if it's ok to update now}
- end;
-
- function TUserInfo.UpdateOK:Boolean; {The 'Ancestor'}
- begin
- Result:= True;
- end;
-
- end.
-
-
-